TITL DAI FIRMWARE 3E3F1-3E5BB  V1.1
        ORG   :E3F1
*
*
*
**************************************************
* ENCODE A TERM WITH A POSSIBLE UNITARY OPERATOR *
**************************************************
*
* L3E381: First operand may be preceeded by unitary
*         operator +, - or INOT.
*         Then code byte preceeding 1st operand is:
*                       +    -  INOT
*               INT:   BC   BD   BE
*               FPT:   9C   9D    *
*
* L3E382: Encodes a sequence of higher priority
*         operations and their operands.
*         Encodes all terms after OLDOP in input
*         which form a succession of higher priority
*         operators until next lower or equal
*         operator is found. This will be in RGTOP.
*         The type of this collection will be in
*         TYPE.
*
* Exit: C,HL updated. BE corrupted. CY=0.
*       A: bits 5,6,7 OLDOP; D: bits 5,6,7 new RGTOP
*
L3E381  CALL  :E6F6     Find unitary operator
 REM in table
        ORA   A
        JNZ   :E444     Jump if found
*
L3E382  SHLD  :0139     Set pntr place for operator
        CALL  :E455     Encode 1st operand
L3E383  CALL  :E6EA     Find binary or unitary
 REM operator in table
        STA   :0137     Store latest prio operator
L3E384  LDA   :0137     Get latest prio operator
        ANI   :E0       Prio in bits 5,6,7
        MOV   D,A       RGTOP in D
        LDA   :0138     Get old prio operator
        ANI   :E0       Prio only
        CMP   D         Compare both operators
        RNC             Ready if RGTOP <= OLDOP
 REM
* RGTOP > OLDOP:
 REM
        XCHG
        LHLD  :0136     Get type latest expression
        PUSH  H         Preserve type left operand
 REM and RGTOP
        LDA   :0138     Get old prio operator
        PUSH  PSW       Preserve it
        PUSH  D         Preserve EBUF pntr
        LHLD  :0139     Get pntr place for operator
        PUSH  H         Preserve HOPPT
        XCHG            New EBUF pntr in HL
        LDA   :0137     Get latest prio operator
        STA   :0138     and store it as old one
        CALL  :E3F8     Encode right hand operand
 REM until higher prio operators
        XCHG
        POP   H
        SHLD  :0139     Restore HOPPT
        POP   H
        SHLD  :013B     Restore RGTPT
        POP   PSW
        STA   :0138     Restore OLDOP
        XCHG            New EBUF pntr in HL
        POP   D         Restore type left operand
 REM (E) and orig RGTOP (D)
        MOV   A,D       Old RGTOP in A
        ANI   :1F       Op.code only
        CALL  :E7CF     Obtain type info for
 REM binary operation
        CALL  :E757     Encode binary operation
 REM into EBUF
        JMP   :E404     Check again if prios correct
 REM
* Unitary operator:
 REM
L3E56   SHLD  :0139     Set pntr place for operator
        PUSH  H
        CALL  :E455     Encode a term
        CALL  :E797     Encode unitary operator
 REM for a term
        POP   D
        CALL  :E783     Byte in A into EBUF
        JMP   :E3FE     Encode sequence with prio's
*
* ENCODE A TERM:
*
* Non-error exit: C,HL: updated.
*                 BCDE corrupted, AF preserved.
*
L3E57   PUSH  PSW
        CALL  :DDD2     Get char from line, neglect
 REM tab + space
        CPI   :22
        JZ    :E49B     Jump if char is '"'
        CPI   :28
        JZ    :E486     Jump if char is '('
        CALL  :DE02     Check if char is upper case
        JC    :E477     Then jump
        CPI   :2D
        JZ    :DA0B     Run 'SYNTAX ERROR' if '-'
        CALL  :E4C8     Encode a number
        JNC   :DA0B     Evt run 'SYNTAX ERROR'
        JMP   :E4A4     Store type and quit
 REM
* If upper case character:
 REM
L3E58   CALL  :E522     Encode function
        JC    :E4A4     If ready: store type (#30)
 REM and quit
        MOV   C,B
        MVI   D,:00
        CALL  :E5BC     Encode var/array reference
        JMP   :E4A7     Quit
 REM
* If opening bracket:
 REM
L3E59   MVI   M,:9A     Load #9A in EBUF
        CALL  :E018     Update EBUF pointer
        INR   C         Next pos in textline
        CALL  :E3C9     Encode expression
        CALL  :DDE0     Get char from line
        CPI   :29
        JNZ   :DA0B     'SYNTAX ERROR' if not ')'
        INR   C         Next pos in textline
        JMP   :E4A7     Quit
 REM
* If opening '"':
 REM
L3E60   NOP
        CALL  :E880     Store quoted text in EBUF
        MVI   A,:20     Type is STR
        JMP   :E4A4     Store type and quit
 REM
* Ready:
 REM
L3E61   STA   :0136     Set type latest expression
L3E62   POP   PSW
        RET
*
***************************
* ENCODE 'SAVEA', 'LOADA' *
***************************
*
*ELODA
ESAVA   CALL  :E678     Enc. array without arguments
        JMP   :E355     Into encode 'SAVE/LOAD'
*
        DATA  :FF
        DATA  :FF
        DATA  :FF
        DATA  :FF
        DATA  :FF
        DATA  :FF
        DATA  :FF
        DATA  :FF
        DATA  :FF
        DATA  :FF
        DATA  :FF
        DATA  :FF
        DATA  :FF
        DATA  :FF
        DATA  :FF
        DATA  :FF
        DATA  :FF
        DATA  :FF
        DATA  :FF
        DATA  :FF
        DATA  :FF
        DATA  :FF
        DATA  :FF
        DATA  :FF
        DATA  :FF
*
*******************
* ENCODE A NUMBER *
*******************
*
* Encodes a INT or a FPT number.
*
* Entry: C : Offset of start of number.
*        HL: Points to EBUF.
*
* On exit: In A:     #00 FPT;  #10 INT;  #10 HEX.
*          In EBUF:  #10 FPT;  #14 INT;  #15 HEX.
*
* On exit, non-hex numbers will only be INT if reqd
* type or IMP type is INT, and there is no '.' or
* 'E' in the input string.
*
* Non-error exit: CY=1: C,HL updated, B preserved.
*                       A: Type-code, DE: entry BC.
* Error exit:     CY=0, BCDEHL preserved.
*
ENUM    PUSH  B
        PUSH  H
        CALL  :DDD2     Get char from line, neglect
 REM tab + space
        CPI   :23
        JZ    :E513     Hex if char is '#'
        LDA   :0290     Get required number type
        ORA   A
        JNZ   :E4DC     Jump if reqd type is not FPT
        LDA   :028F     Get default number type
ENM03   CPI   :00
        JZ    :E4FF     Jump if type is not FPT
 REM
* If INT:
 REM
        MVI   M,:14     Load #14 in EBUF
        CALL  :E018     Update EBUF pointer
        CALL  :E57B     INT nr into EBUF
        JNC   :E4FF     Then handle as FPT
        CALL  :DDE0     Get char from line
        CPI   :2E
        JZ    :E4FF     Try FPT if no digits before
 REM the '.'
        CPI   :45
        JZ    :E4FF     Handle as FPT if 'E'
ENM05   MVI   A,:10     Type is INT
ENM10   POP   D
        POP   D
        STC             CY=1
        RET
 REM
* If FPT:
 REM
ENM20   POP   H
        POP   B
 REM
* Entry from ETCON:
 REM
ENM25   PUSH  B         ) Save pointers
        PUSH  H         )
        MVI   M,:10     Load #10 in EBUF
        CALL  :E018     Update EBUF pointer
        CALL  :E596     FPT nr into EBUF
        MVI   A,:00     Type is FPT
        JC    :E4FB     Jump if no errors
        POP   H
        POP   B
        RET             Error exit (no number)
 REM
* If HEX:
 REM
ENM30   MVI   M,:15     Load #15 in EBUF
        CALL  :E018     Update EBUF pointer
        NOP
        CALL  :E884     Hex nr into EBUF
        JNC   :DA0B     Run 'SYNTAX ERROR' if no
 REM digits
        JMP   :E4F9     Quit
*
*********************
* ENCODE A FUNCTION *
*********************
*
* Reads a system function (both function and
* arguments) into EBUF. Error exit if syntax or
* type mismatch errors are found.
*
* Entry:   HL: Points to 1st free pos. in EBUF.
*          C : Points to input.
* Exit: If found: CY=1:
*          A:  Type info of result.
*          C,HL updated; BDE corrupted.
*       If not found: CY=0:
*          A:  End of table count.
*          B:  Start of name in input.
*          C:  Points beyond.
*          DE: Points to 0 T/L byte at table end.
*          HL: Points to EBUF.
*
EFUN    PUSH  H
        STC             Set 'include type letter'
        CALL  :E6FD     Find variable name in input,
 REM allow !,%,$.
        LXI   H,:CFE6   Addr table BASIC functions
        CALL  :CA5A     Find function in table
        MOV   A,E       Get serialnr of entry in
 REM table in A
        XCHG
        POP   H
        JNC   :E57A     Abort if not found (CY=0)
 REM
* If found in table:
 REM
        MVI   M,:20     Load fn.code (#20) in EBUF
        CALL  :E018     Update EBUF pointer
        MOV   M,A       Load how manyth function
 REM in EBUF
        CALL  :E018     Update EBUF pointer
        LDAX  D         Get T/L byte of function
        INX   D
        PUSH  PSW       Preserve it
        ANI   :0F       Length only
        JZ    :E576     Jump if no arguments reqd
 REM
* If arguments required:
 REM
        PUSH  PSW       Preserve length fuction
        CALL  :E867     Check if next char is '(',
        DATA  :28       run 'SYNTAX ERROR' if not
L3E72   XCHG
        MOV   A,M       Get T/L byte
        INX   H
        XCHG
        CPI   :30       Boolean type ?
        CZ    :E5BC     Then encode var/array ref.
        JZ    :E565     and jump
        CPI   :20       STR type ?
        CZ    :E3A1     Then encode STR expr
        JZ    :E565     and jump
        CPI   :10       INT type ?
        CZ    :E36D     Then encode INT expr
        CNZ   :E376     Else: encode FPT expr
*
L3E73   POP   PSW       Get length function
        DCR   A         Check if all arguments done
        JZ    :E572     Jump if ready
        PUSH  PSW       Preserve T/L function
        CALL  :E867     Check if next char is ',',
        DATA  :2C       run 'SYNTAX ERROR' if not
        JMP   :E549     Encode next argument
L3E74   CALL  :E867     Check if next char is ')',
        DATA  :29       run 'SYNTAX ERROR' if not
L3E75   POP   PSW       Get T/L function
        ANI   :30       Type only
        STC             CY=1
L3E76   RET
*
************************
* INT NUMBER INTO EBUF *
************************
*
* Entry: C : Points to input.
*        HL: Points to EBUF.
*
EINT    CALL  :DDD2     Get char from line, neglect
 REM tab + space
        CPI   :2D
        JNZ   :E585     Jump if char is not '-'
        INR   C
        XRA   A         Else: clear sign bit
L3E78   CALL  :C024     Input INT number to MACC
        JNZ   :E58D     Jump if nr was >= 0
        RST   4         Change sign MACC
        DATA  :60
L3E79   JMP   :E5A3     Move MACC into EBUF
*
************************
* HEX NUMBER INTO EBUF *
************************
*
L3E80   CALL  :C02A     Input HEX number to MACC
        JMP   :E5A3     Move MACC into EBUF
*
************************
* FPT NUMBER INTO EBUF *
************************
*
* Entry: C : Points to input.
*        HL: Points to EBUF.
* Non-error exit:  CY=1:
*        C,HL updated. B preserved. A corrupted.
*        DE: Location of number in EBUF.
* Error exit: CY=0:
*        BDEHL preserved, A corrupted, C updated.
*
EFPT    CALL  :DDD2     Get char from line, neglect
 REM tab + space
        CPI   :2D
        JNZ   :E5A0     Jump if char is not '-'
        INR   C
        XRA   A         Else: clear sign bit
L3E82   CALL  :E879     FPT nr into MACC, evt
 REM change sign
 REM
* Entry for HEX/INT numbers:
 REM
L3E83   JNC   :E5BB     Abort if there are no digits
        PUSH  B
        MOV   D,H       Old EBUF pntr in DE
        MOV   E,L
        CALL  :E018     ) Update EBUF pointer
        CALL  :E018     ) to after new input
        CALL  :E018     )
        CALL  :E018     )
        XCHG
        RST   4         Copy MACC into EBUF
        DATA  :0F
        XCHG
        POP   B
        STC             CY=1
L3E84   RET
*
*
*
        UNL
ELODA   EQU ESAVA
        LST
        END